{ Image Macros for intensity calculations on Photometrics CCD images }

{Globals}
var
    {16 to 8 conversion info}
    ymin, ymax,
    
    {pid numbers for images}
    customLUTpid, smoothPid,
    raw16Pid, rawWidth, rawHeight,
    proc16Pid, proc8Pid, procXmin, procXmax,
    temp16Pid, flagPid, 
    mask1Pid, maskWidth, maskHeight,
    seg8aPid, seg8bPid, bkgSegPid,
    dark16Pid, unif16Pid,

    {segmentation}
    segN,
    
    svL,svT,svW,svH {save ROI values}

: integer;
{initialize/restore globals}
begin
    requiresUser('Pixel16u',2);
    requiresUser('GetPutPixel',1);
    requiresUser('timer',1);
    requiresUser('utilities',1);
    requiresUser('markup',1);
    
    ymin := getMemo('ymin');
    ymax := getMemo('ymax');

    {pid numbers}

    customLUTpid := getMemo('customLUTpid');
    smoothPid := getMemo('smoothPid');
    raw16Pid := getMemo('raw16Pid');
    rawWidth := getMemo('rawWidth');
    rawHeight := getMemo('rawHeight');
    proc16Pid := getMemo('proc16Pid');
    temp16Pid := getMemo('temp16Pid');
    flagPid := getMemo('flagPid');
    mask1Pid := getMemo('mask1Pid');
    maskWidth := getMemo('maskWidth');
    maskHeight := getMemo('maskHeight');
    proc8Pid := getMemo('proc8Pid');
    procXmin := getMemo('procXmin');
    procXmax := getMemo('procXmax');
    seg8aPid := getMemo('seg8aPid');
    seg8bPid := getMemo('seg8bPid');
    bkgSegPid := getMemo('bkgSegPid');
    dark16Pid := getMemo('dark16Pid');
    unif16Pid := getMemo('unif16Pid');
    
    segN := getMemo('segN');
    if segN < 1 then segN := 1;
    if segN > 250 then segN := 250;
    setMemo('segN',segN);

    svL := getMemo('svL');
    svT := getMemo('svT');
    svW := getMemo('svW');
    svH := getMemo('svH');

    SetBackgroundColor(0);
    SetForeGroundColor(255);
end;

procedure disposePic(pid: integer);
begin
    selectPic(pid);
    dispose;
end;

procedure autoDispose(p);
begin
    if pidExists(p) then begin
        disposePic(p);
    end;
end;
procedure createSmoothKernel;
var
    x, y: integer;
    sum: real;
begin
    RequiresUser('getputpixel', 1);
    AutoDispose(smoothPid);
    SaveState;
    SetNewSize(kw * 4, kh + 1);
    MakeNewWindow('kernel ', kx : 0, 'x ', ky : 0, 'y ', kw : 0, 'w ', kh : 0, 'h');
    smoothPid := pidNumber;
    SetMemo('smoothPid', smoothPid);
    RestoreState;
    putPixel(0, 0, kx);
    putPixel(1, 0, ky);
    putPixel(2, 0, kw);
    putPixel(3, 0, kh);
    sum := 0.0;
    for x := -kx to kw - kx - 1 do begin
        for y := -ky to kh - ky - 1 do begin
            sum := sum + exp(-sqrt(sqr(x) + sqr(y)));
        end;
    end;
    sum := 32000.0 / sum; {nearly maximum before overflow on 65535 pixel}
    for x := -kx to kw - kx - 1 do begin
        for y := -ky to kh - ky - 1 do begin
            putPixel32s(smoothPid, x + kx, y + ky + 1, sum * exp(-sqrt(sqr(x) + sqr(y))));
        end;
    end;
    sum := 0.0;
    for x := -kx to kw - kx - 1 do begin
        for y := -ky to kh - ky - 1 do begin
            sum := sum + getPixel32s(smoothPid, x + kx, y + ky + 1);
        end;
    end;
    showmessage('kernel sum = ', sum);
    SelectPic(smoothPid);
    MakeRoi(0, 1, kw * 4, kh);
end;

procedure stdSmooth;
var
    kx, ky, kw, kh: integer;
begin
    kx := 1;
    ky := 1;
    kw := 3;
    kh := 3;
    createSmoothKernel;
end;

macro 'Create standard 3x3 smoothing kernel';
begin
    stdSmooth;
end;

macro 'Create arbitrary smoothing kernel';
var
    kx, ky, kw, kh: integer;
begin
    kw := GetNumber('kernel width',5);
    kh := GetNumber('kernel height',5);
    kx := GetNumber('kernel x center',kw div 2);
    ky := GetNumber('kernel y center',kh div 2);
    createSmoothKernel;
end;

procedure setMaskSize;
var
    kx, ky, kw, kh: integer;
    front: integer;
begin
    front := pidNumber;
    {find size of smoothing kernel}
    ChoosePic(smoothPid);
    kx := getPixel(0, 0);
    ky := getPixel(1, 0);
    kw := getPixel(2, 0);
    kh := getPixel(3, 0);

    MakeRoi(0, 1, kw * 4, kh);
    maskWidth := rawWidth + kw - 1;
    maskHeight := rawHeight + kh - 1;
    SetMemo('maskWidth',maskWidth);
    SetMemo('maskHeight',maskHeight);
    ChoosePic(front);
end;

procedure forceROIWithin;
var
    left, top, rwidth, rheight, iwidth, iheight: integer;
begin
    GetPicSize(iwidth,iheight);
    GetRoi(left,top,rwidth,rheight);
    if rwidth = 0 then selectAll; {this fixes most cases}
    GetRoi(left,top,rwidth,rheight);
    if (left < 0) 
    or (top < 0) 
    or (left + rwidth > iwidth) 
    or (top + rheight > iheight) then begin
        putmessage('ROI must not extend outside image');
        exit;
        {make ROI doesn't hack it if ROI wasn't rectangular...}
        if left < 0 then begin
            rwidth := rwidth + left;
            left := 0;
        end;
        if top < 0 then begin
            rheight := rheight + top;
            top := 0;
        end;
        if left + rwidth > iwidth then begin
            rwidth := iwidth - left;
        end;
        if top + rheight > iheight then begin
            rheight := iheight - top;
        end;
        makeroi(left,top,rwidth,rheight);
    end;
end;

procedure forceUncalib;
begin
    SelectPic(proc8Pid);
    if Calibrated then begin
        selectAll;
        copy;
        disposePic(proc8Pid);
        SaveState;
        setNewSize(rawWidth, rawHeight);
        makeNewWindow('Processed 8 bit image');
        proc8Pid := pidNumber;
        setMemo('proc8Pid',proc8Pid);
        RestoreState;
        Paste;
        KillRoi;
    end;
    SelectPic(proc8Pid);
end;

{adjust xmin/xmax using mean ± stdev}
procedure enhanceStdev;
var
    mean, sigma, coef: real;
begin
    choosePic(proc16Pid);
    KillROI;
    choosePic(proc8Pid);
    forceROIWithin;
    forceUncalib;
    KillROI;
    coef := (procXmax - procXmin + 1) / (ymax - ymin + 1);
{might not work if coef < 0???}
    linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax);
    Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid);
    RestoreRoi; {take mean & stdev over ROI of 8 bit image}
    SetOptions('Area,Mean,Std. Dev.,User1,User2');
    SetCounter(513);
    Measure;
    mean := (rmean[rCount]-ymin) * coef + procXmin + coef / 2;
    sigma := rStdDev[rCount] * coef + coef / 2;
    ruser1[rCount] := coef;
    ruser2[rCount] := mean;
    {serious round off errors happen when sigma < coef }
    {so that the mean is not known well enough, }
    {image comes out white or black}
    if sigma < coef then sigma := coef;
    procXmin := mean - 2*sigma; {this needs to be an adjustable parameter}
    procXmax := mean + 4*sigma;
    SetMemo('procXmin',procXmin);
    SetMemo('procXmax',procXmax);
end;

{adjust xmin/xmax using mean and maximum}
{revised:  use mean of inner ROI and then mean of outer ROI}
procedure adjMeanMax;
var
    mean, sigma, coef: real;
begin
    choosePic(proc16Pid);
    KillROI;
    choosePic(proc8Pid);
    forceROIWithin;
    forceUncalib;
    KillROI;
    coef := (procXmax - procXmin + 1) / (ymax - ymin + 1);
{might not work if coef < 0???}
    linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax);
    Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid);
    RestoreRoi; {take mean & stdev over ROI of 8 bit image}
    SetCounter(513);
    SetOptions('Area,Mean,Std. Dev.,User1,User2');
    Measure;
    InsetRoi(-20);
    Measure;
    mean := (rmean[rCount]-ymin) * coef + procXmin + coef / 2;
    sigma := (rmean[rCount-1]+2*rStdDev[rCount-1]-ymin) * coef + procXmin + coef / 2;
    sigma := (sigma - mean) / 4;
    ruser1[rCount] := coef;
    ruser2[rCount] := mean;
    if sigma < coef then sigma := coef;
    procXmin := mean - 0.75*sigma; {this needs to be an adjustable parameter}
    procXmax := mean + 4*sigma;
    SetMemo('procXmin',procXmin);
    SetMemo('procXmax',procXmax);
end;

{display 16 bit data into the 8 bit image using specified xmin/xmax}
procedure show16;
var
    lower, upper: integer;
begin
    choosePic(proc16Pid);
    KillROI;
    choosePic(proc8Pid);
    forceROIWithin;
    KillROI;
    linLUT16uto8(customLUTPid, procXmin, procXmax, ymin, ymax);
    Cnvrt16uto8(proc16Pid, customLUTPid, proc8Pid);
    RestoreRoi;
    SelectPic(proc8Pid);
    GetThresholds(lower, upper);
    ShowMessage(procXmin,' min\',procXmax,' max\',lower,' lower\',upper,' upper\');
end;

procedure swapTemp16;
var
    temp: integer;
begin
    temp := temp16Pid;
    temp16Pid := proc16Pid;
    proc16Pid := temp;
    SetMemo('temp16Pid',temp16Pid);
    SetMemo('proc16Pid',proc16Pid);
    temp := pidNumber;
    choosePic(proc16Pid);
    SetPicName('Processed 16 bit image');
    killROI;
    choosePic(temp16Pid);
    SetPicName('Temporary 16 bit image');
    killROI;
    choosePic(temp);
end;

procedure hide8image;
var
    width, height: integer;
begin
    SelectPic(proc8Pid);
    setDensitySlice(0,0);
    setforegroundcolor(255);
    setbackgroundcolor(0);
    selectAll;
    clear;
    getPicSize(width, height);
    moveto(width div 3, height div 3);
    writeln('Press 8 to display image');
end;

procedure checkSize(p,w,h: integer);
var
    width, height, front: integer;
begin
    if pidExists(p) then begin
        front := pidNumber;
        choosePic(p);
        getPicSize(width, height);
        choosePic(front);
        if (width <> w) or (height <> h) then disposePic(p);
    end;
end;

procedure LUT(x, r, g, b);
begin
    RedLut[x] := r;
    GreenLut[x] := g;
    BlueLut[x] := b;
end;

procedure segLUT;
begin
        ResetGrayMap;
        LUT(1,255,0,0);
        LUT(2,0,255,0);
        LUT(3,0,0,255);
        LUT(4,255,255,0);
        LUT(5,0,255,255);
        LUT(6,255,0,255);
        LUT(7,255,128,128);
        LUT(8,128,255,128);
        LUT(9,128,128,255);
        UpdateLUT;
end;


{if the scratch windows are wrong size or missing, create them}
procedure makeScratchIfNeed;
var
    width, height: integer;
begin
    SelectPic(pidNumber);
    saveState;
    if (ymin = 0) and (ymax = 0) then begin
        ymin := 1;
        ymax := 254;
    end;
    if (ymin < 0) or (ymin > 255) then ymin := 1;
    if (ymax < 0) or (ymax > 255) then ymax := 254;
    if ymin > ymax then begin
        ymin := 1;
        ymax := 254;
    end;
    SetMemo('ymin',ymin);
    SetMemo('ymax',ymax);
    if not pidExists(customlutPid) then begin
        setNewSize(256,256);
        makeNewWindow('custom LUT');
        SelectAll;
        KillRoi;
        customLUTpid := pidNumber;
        SetMemo('customLUTpid',customLUTpid);
    end;
    linLUT16uto8(customLUTpid, 0, 65535, ymin, ymax);

    if not pidExists(smoothPid) then begin
        stdSmooth;
    end;

    if not pidExists(raw16Pid) then begin
        putMessage('makeScratch no raw16');
        exit;
    end;
    choosePic(raw16Pid);
    getPicSize(width, height);
    rawWidth := (width div 4) * 2;
    rawHeight := height;
    setMemo('rawWidth',rawWidth);
    setMemo('rawHeight',rawHeight);
    if rawWidth * 2 <> width then begin
        putMessage('makeScratch raw width not multiple of 4');
        exit;
    end;

    checkSize(proc16Pid,rawWidth * 2,rawHeight);
    if not pidExists(proc16Pid) then begin
        setNewSize(rawWidth * 2, rawHeight);
        makeNewWindow('Processed 16 bit image');
        SelectAll;
        KillRoi;
        proc16Pid := pidNumber;
        SetMemo('proc16Pid',proc16Pid);
    end;

    checkSize(temp16Pid,rawWidth * 2,rawHeight);
    if not pidExists(temp16Pid) then begin
        setNewSize(rawWidth * 2, rawHeight);
        makeNewWindow('Temporary 16 bit image');
        SelectAll;
        KillRoi;
        temp16Pid := pidNumber;
        SetMemo('temp16Pid',temp16Pid);
    end;
    
    checkSize(dark16Pid,rawWidth * 2,rawHeight);
    if not pidExists(dark16Pid) then begin
        setNewSize(rawWidth * 2, rawHeight);
        makeNewWindow('Dark 16 bit image');
        SelectAll;
        KillRoi;
        dark16Pid := pidNumber;
        SetMemo('dark16Pid',dark16Pid);
    end;
    
    checkSize(unif16Pid,rawWidth * 2,rawHeight);
    if not pidExists(unif16Pid) then begin
        setNewSize(rawWidth * 2, rawHeight);
        makeNewWindow('Uniform 16 bit image');
        SelectAll;
        KillRoi;
        unif16Pid := pidNumber;
        SetMemo('unif16Pid',unif16Pid);
    end;
    
    checkSize(flagPid,rawWidth,rawHeight);
    if not pidExists(flagPid) then begin
        setNewSize(rawWidth, rawHeight);
        makeNewWindow('smoothing flag image');
        SelectAll;
        KillRoi;
        flagPid := pidNumber;
        SetMemo('flagPid',flagPid);
    end;
    
    setMaskSize;
    checkSize(mask1Pid,maskWidth,maskHeight);
    if not pidExists(mask1Pid) then begin
        setNewSize(maskWidth, maskHeight);
        makeNewWindow('smoothing mask image 1');
        SelectAll;
        KillRoi;
        mask1Pid := pidNumber;
        SetMemo('mask1Pid',mask1Pid);
    end;

    checkSize(proc8Pid,rawWidth,rawHeight);
    if not pidExists(proc8Pid) then begin
        setNewSize(rawWidth, rawHeight);
        makeNewWindow('Processed 8 bit image');
        SelectAll;
        KillRoi;
        proc8Pid := pidNumber;
        setMemo('proc8Pid',proc8Pid);
    end;

    checkSize(seg8aPid,rawWidth,rawHeight);
    if not pidExists(seg8aPid) then begin
        setNewSize(rawWidth, rawHeight);
        makeNewWindow('Segments A');
        SegLUT;
        SelectAll;
        KillRoi;
        seg8aPid := pidNumber;
        setMemo('seg8aPid',seg8aPid);
    end;

    checkSize(seg8bPid,rawWidth,rawHeight);
    if not pidExists(seg8bPid) then begin
        setNewSize(rawWidth, rawHeight);
        SelectPic(seg8aPid);
        makeNewWindow('Segments B');
        SegLUT;
        SelectAll;
        KillRoi;
        seg8bPid := pidNumber;
        setMemo('seg8bPid',seg8bPid);
    end;

    checkSize(bkgSegPid,rawWidth,rawHeight);
    if not pidExists(bkgSegPid) then begin
        setNewSize(rawWidth, rawHeight);
        makeNewWindow('Background Segments');
        SelectAll;
        KillRoi;
        bkgSegPid := pidNumber;
        setMemo('bkgSegPid',bkgSegPid);
    end;

    restoreState;
end;

macro 'seg LUT';
begin
    segLUT;
end;

procedure copyRawToProc;
begin
    choosePic(raw16Pid);
    selectAll;
    copy;
    killRoi;
    choosePic(proc16Pid);
    selectAll;
    paste;
    killRoi;
end;

{
import arbitrary IPLab image:
if (getpixel(0,0) <> ord('2')) 
or (getpixel(1,0) <> ord('.'))
or (getpixel(2,0) <> ord('3'))
or (getpixel(3,0) <> ord('a'))
or (getpixel(4,0) <> 0)
or (getpixel(5,0) <> 1) {short int}
then
else
 width := ((getpixel(6,0) * 256 + getpixel(7,0)) * 256 + getpixel(8,0)) * 256 + getpixel(9,0);
 height := ((getpixel(10,0) * 256 + getpixel(11,0)) * 256 + getpixel(12,0)) * 256 + getpixel(13,0);
 offset := 2120;
}

{if there is no raw data image, import one}
procedure importIfNeed;
var 
   origPid: integer;
begin
    origPid := 0;
    if not pidExists(raw16Pid) then begin
        SaveState;
        SetImport('8-bits,Custom');
        SetCustom(2634,1034,2124);
        Import('');
        origPid := pidNumber;
        {MakeNewWindow will not make odd width windows.}
        {Therefore, 16 bit images must be even # pixels wide}
        {or width multiple of 4}
        SetNewSize(2632,1032);
        MakeRoi(0, 2, 2632,1032);
        Copy;
        MakeNewWindow(GetPicName);
        raw16Pid := pidNumber;
        SetMemo('raw16Pid',raw16Pid);
        Paste;
        KillROI;
        disposePic(origPid);
        RestoreState;
    end;
    makeScratchIfNeed;
    SelectPic(proc8Pid);
    if origPid <> 0 then begin
        CopyRawToProc;
    end;
end;

macro '[1] copy proc to dark image';
begin
    SelectPic(proc8Pid);
    choosePic(proc16Pid);
    selectAll;
    copy;
    killRoi;
    choosePic(dark16Pid);
    selectAll;
    paste;
    killRoi;
    SelectPic(proc8Pid);
end;
macro '[2] copy proc to uniform image';
begin
    SelectPic(proc8Pid);
    choosePic(proc16Pid);
    selectAll;
    copy;
    killRoi;
    choosePic(unif16Pid);
    selectAll;
    paste;
    killRoi;
    SelectPic(proc8Pid);
end;

macro '[d] subtract dark image';
begin
    SelectPic(proc8Pid);
    choosePic(proc16Pid);
    killROI;
    choosePic(temp16Pid);
    killROI;
    choosePic(dark16Pid);
    killROI;
    sub16u(proc16Pid,dark16Pid,temp16Pid);
    swapTemp16;
    hide8Image;
    writeln('subtract dark');
end;

macro '[f] flat field -- divide by uniform image';
begin
    SelectPic(proc8Pid);
    choosePic(proc16Pid);
    killROI;
    choosePic(temp16Pid);
    killROI;
    choosePic(unif16Pid);
    killROI;
    ratio16u(proc16Pid,unif16Pid,temp16Pid,16384);
    swapTemp16;
    hide8Image;
    writeln('divide by uniform');
end;

procedure mySaveROI;
begin
    getRoi(svL,svT,svW,svH);
    makeRoi(svL,svT,svW,svH);
    setMemo('svL',svL);
    setMemo('svT',svT);
    setMemo('svW',svW);
    setMemo('svH',svH);
end;
macro '[F9] Save ROI';
begin
    mySaveROI;
end;
macro '[F10] Restore saved ROI';
begin
    makeRoi(svL,svT,svW,svH);
end;

macro '[a] start over from raw image';
begin
    SelectPic(proc8Pid);
    importIfNeed;
    CopyRawToProc;
    hide8Image;
    writeln('raw data');
end;

macro '[z] undo last 16 bit transform';
begin
    SelectPic(proc8Pid);
    swapTemp16;
    hide8Image;
    writeln('undo');
end;

procedure doReduceNoise;
begin
    SelectPic(proc8Pid);
    {actually only need to copy the border}
    choosePic(proc16Pid);
    selectAll;
    copy;
    killRoi;
    choosePic(temp16Pid);
    selectAll;
    paste;
    {end copy}
    choosePic(proc16Pid);
    makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
    choosePic(temp16Pid);
    makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
    median16u(proc16Pid,temp16Pid);
    choosePic(proc16Pid);
    killROI;
    choosePic(temp16Pid);
    killROI;
    swapTemp16;
    hide8Image;
    writeln('reduce noise');
end;

macro '[r]reduce noise';
begin
    doReduceNoise;
end;

procedure doRadMed(radius: real);
var
    r: integer;
begin
    SelectPic(proc8Pid);
    r := round(radius + 0.5);
    {actually only need to copy the border}
    choosePic(proc16Pid);
    selectAll;
    copy;
    killRoi;
    choosePic(temp16Pid);
    selectAll;
    paste;
    killRoi;
    {end copy}
    choosePic(proc16Pid);
    makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r);
    choosePic(temp16Pid);
    makeRoi(2*r,r,(rawWidth-2*r)*2,rawHeight-2*r);
    radMedian16u(proc16Pid,temp16Pid,radius);
    choosePic(proc16Pid);
    killROI;
    choosePic(temp16Pid);
    killROI;
    swapTemp16;
    hide8Image;
    writeln('radial median filter');
end;

macro 'radial median filter';
var
    radius: real;
begin
    radius := getNumber('radius',10);
    doRadMed(radius);
end;

macro '[4] Radial median filter 30 10';
begin
    doRadMed(30);
    doRadMed(10);
end;

macro '[m]min spatial filter';
begin
    SelectPic(proc8Pid);
    choosePic(proc16Pid);
    makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
    choosePic(temp16Pid);
    makeRoi(2,1,(rawWidth-2)*2,rawHeight-2);
    minspat16u(proc16Pid,temp16Pid);
    choosePic(proc16Pid);
    killROI;
    choosePic(temp16Pid);
    killROI;
    swapTemp16;
    hide8Image;
    writeln('min spatial');
end;

macro '[s] smooth';
var
    kx, ky, kw, kh: integer;
begin
    SelectPic(proc8Pid);
    SetBackgroundColor(0);
    ChoosePic(proc16Pid);
    killRoi;
    ChoosePic(temp16Pid);
    killRoi;
    ChoosePic(smoothPid);
    kx := getPixel(0, 0);
    ky := getPixel(1, 0);
    kw := getPixel(2, 0);
    kh := getPixel(3, 0);
    MakeRoi(0, 1, kw * 4, kh);
    ChoosePic(flagPid);
    SelectAll;
    Clear;
    KillRoi;
    ChoosePic(mask1Pid);
    MakeRoi(kx, ky, rawWidth, rawHeight);
    Clear;
    SetForegroundColor(255);
    MakeRoi(0, 0, kx, rawHeight + kh);
    Fill;
    MakeRoi(kx + rawWidth, 0, kw - kx - 1, rawHeight + kh);
    Fill;
    MakeRoi(kx, 0, rawWidth, ky);
    Fill;
    MakeRoi(kx, ky + rawHeight, rawWidth, kh - ky - 1);
    Fill;
    {Mask image must have an ROI same size as image and}
    {with borders matching kernel, thus:}
    MakeRoi(kx, ky, rawWidth, rawHeight);
    Convolve16u(flagPid, proc16Pid, smoothPid, kx, ky, mask1Pid, temp16Pid);
    swapTemp16;
    hide8Image;
    writeln('smooth');
end;

macro 'Copy 8 bit image to seg8b and make binary';
var
    lower, upper: integer;
begin
    SelectPic(proc8Pid);
    GetThresholds(lower, upper);
    SelectAll;
    Copy;
    ChoosePic(seg8bPid);
    SelectAll;
    Paste;
    if upper = 255 then begin
        SetThreshold(lower);
    end else begin
        SetDensitySlice(lower,upper);
    end;
    MakeBinary;
    SelectPic(seg8bPid);
end


macro '[3]Load a new image';
begin
    disposePic(raw16Pid);
    importIfNeed;
    minmax16u(proc16Pid, procXmin, procXmax);
    SetMemo('procXmin',procXmin);
    SetMemo('procXmax',procXmax);
    show16;
    enhanceStdev;
    show16;
end;

macro 'Front 16 bit image is raw data';
begin
    raw16Pid := pidNumber;
    SetMemo('raw16Pid',raw16Pid);
    SelectPic(raw16Pid);
    makeScratchIfNeed;
    CopyRawToProc;
    hide8Image;
    writeln('raw data');
end;

macro '[7]Convert to 8 bit with mean max scaling';
begin
    importIfNeed;
    minmax16u(proc16Pid, procXmin, procXmax);
    SetMemo('procXmin',procXmin);
    SetMemo('procXmax',procXmax);
    show16;
    adjMeanMax;
    show16;
    mySaveROI;
    Copy;
end;


macro '[*]Convert to 8 bit with min max scaling';
begin
    importIfNeed;
    minmax16u(proc16Pid, procXmin, procXmax);
    SetMemo('procXmin',procXmin);
    SetMemo('procXmax',procXmax);
    show16;
end;

macro '[8]Convert to 8 bit with mean ± stdev scaling';
begin
    importIfNeed;
    minmax16u(proc16Pid, procXmin, procXmax);
    SetMemo('procXmin',procXmin);
    SetMemo('procXmax',procXmax);
    show16;
    enhanceStdev;
    show16;
end;

macro '[¥]Enhance ROI of 8 bit image';
begin
    importIfNeed;
    enhanceStdev;
    show16;
end;

macro '[9]- xmin';
begin
    importIfNeed;
    procXmin := round(procXmin - 0.1*(procXmax - procXmin) - 1);
    if procXmin > procXmax then procXmax := procXmin + 1;
    SetMemo('procXmin',procXmin);
    show16;
end;

macro '[»]+ xmin';
begin
    importIfNeed;
    procXmin := round(procXmin + 0.1*(procXmax - procXmin) + 1);
    if procXmin > procXmax then procXmax := procXmin + 1;
    SetMemo('procXmin',procXmin);
    show16;
end;

macro '[0]- xmax';
begin
    importIfNeed;
    procXmax := round(procXmax - 0.1*(procXmax - procXmin) - 1);
    if procXmax < procXmin then procXmin := procXmax - 1;
    SetMemo('procXmin',procXmin);
    show16;
end;
macro '[¼]+ xmax';
begin
    importIfNeed;
    procXmax := round(procXmax + 0.1*(procXmax - procXmin) + 1);
    if procXmin > procXmax then procXmin := procXmax - 1;
    SetMemo('procXmin',procXmin);
    show16;
end;

macro '[g] Show processed 8 bit image';
begin
    SelectPic(proc8Pid);
end;

macro '[©] Reconvert 8 bit image';
begin
    Show16;
end;

macro '[F13] Enable Density Slice';
begin
    SetDensitySlice(255,255);
end;

procedure adjustsegN(offset: integer);
var
    wrap: integer;
begin
    if offset < 0 then
        wrap := 250
    else
        wrap := 1;
    segN := segN + offset;
    if segN > 250 then segN := wrap;
    if segN < 1 then segN := wrap;
    setMemo('segN',segN);
end;

macro '[j] show seg A';
begin
    adjustsegN(0);
    SelectPic(seg8aPid);
    ShowMessage(segN,' Segment\');
end;

procedure appendROI;
var 
    fg, lower,upper: integer;
begin
    fg := pidNumber;
    GetThreshold(lower,upper);
    SetDensitySlice(0,0);
    KillRoi;
    RestoreRoi;
    Clear;
    ChoosePic(seg8aPid);
    SetBackgroundColor(0);
    SetForegroundColor(segN);
    RestoreRoi;
    fill;
    SetCounter(513);
    Measure;
    rX[segN+256] := rX[rCount];
    rY[segN+256] := rY[rCount];
    rMin[segN+256] := segN;
    rMax[segN+256] := segN;
    SetForegroundColor(255);
    SelectPic(fg);
    ShowMessage(segN,' Segment\',lower,'lower\',upper,'upper\');
    if upper = 255 then
         SetThreshold(lower)
    else
         SetDensitySlice(lower,upper);
end;

macro '[n]ROI is next segment';
begin
    adjustsegN(1);
    appendROI;
end;

procedure eraseSegment;
var 
    fg, lower,upper: integer;
begin
    fg := pidNumber;
    GetThreshold(lower,upper);
    SetDensitySlice(0,0);
    ChoosePic(seg8aPid);
    ChangeValues(segN,segN,0);
    rX[segN+256] :=0;
    rY[segN+256] :=0;
    rUser1[segN+256] := 0;
    rUser2[segN+256] := 0;
    rMin[segN+256] := 0;
    rMax[segN+256] := 0;
    SelectPic(fg);
    ShowMessage(segN,' Segment\',lower,'lower\',upper,'upper\');
    if upper = 255 then
         SetThreshold(lower)
    else
         SetDensitySlice(lower,upper);
end;

macro '[b] erase seg';
begin
    eraseSegment;
end;

macro '[F1]Clear segs';
var
    i: integer;
begin
    SelectPic(seg8aPid);
    SetBackgroundColor(0);
    SelectAll;
    Clear;
    SelectPic(proc8Pid);
    segN := 250;
    SetMemo('segN',segN);
    for i := 256 to 511 do begin
        rX[i] := 0;
        rY[i] := 0;
        rUser1[i] := 0;
        rUser2[i] := 0;
        rMin[i] := 0;
        rMax[i] := 0;
        rAngle[i] := 0;
    end;
    SetCounter(513);
end;

macro '[F2]dilate segs A onto B';
var
    r: integer;
    width,height: integer;
begin
    SelectPic(seg8aPid);
    r := 5;
    r := GetNumber('dilation radius',r);
    SelectAll;
    Copy;
    InsetRoi(r+1);
    choosePic(seg8bPid);
    SelectAll;
    Paste;
    InsetRoi(r+1);
    Dilate8Circular(seg8aPid, seg8bPid, r);
    choosePic(seg8aPid);
    KillRoi;
    SelectPic(seg8bPid);
    KillRoi;
end;

macro '[F3]copy segs B onto A';
begin
    SelectPic(seg8bPid);
    SelectAll;
    Copy;
    KillRoi;
    SelectPic(seg8aPid);
    SelectAll;
    Paste;
    KillRoi;
end;

macro '[F4]copy 8 to Background';
begin
    SelectPic(Proc8Pid);
    SelectAll;
    Copy;
    KillRoi;
    SelectPic(BkgSegPid);
    SelectAll;
    Paste;
    KillRoi;
    SetCounter(513);
    Measure;
    SetDensitySlice(rMean[rCount]-rStdDev[rCount]/2, rMean[rCount]+rStdDev[rCount]/2);
end;

macro '[F5]intensities using segments A';
var
    i, j, k, r, x, area, sum: integer;
    sumPid: integer;
    avgBkg, total: real;
begin
    showmessage('finding neighborhood of segments');
    SelectPic(seg8aPid);
    SelectAll;
    Copy;
    KillRoi;

    r := 5;
    ChoosePic(flagPid);
    SelectAll;
    Paste;
    ChangeValues(1,255,1);
    Copy;
    InsetRoi(r+1);
    ChoosePic(seg8bPid);
    SelectAll;
    Paste;
    InsetRoi(r+1);
    Dilate8Circular(flagPid, seg8bPid, r);
    ChoosePic(seg8bPid);
    SelectAll;
    Copy;
    r := 10;
    ChoosePic(flagPid);
    SelectAll;
    Paste;
    InsetRoi(r+1);
    ChoosePic(seg8bPid);
    SelectAll;
    Invert;
    Copy;
    Invert;
    InsetRoi(r+1);
    Dilate8Circular(seg8bPid, flagPid, r);
    ChoosePic(flagPid);
    SelectAll;
    Paste;
    DoAnd;
    ChangeValues(1,255,255);
    Showmessage('finding background pixels');
    ChoosePic(BkgSegPid);
    SelectAll;
    Copy;
    ChoosePic(flagPid);
    SelectAll;
    Paste;
    DoAnd;
    SelectAll;
    Copy;
    ChoosePic(Seg8bPid);
    Paste;
    ChoosePic(Seg8aPid);
    SelectAll;
    Copy;
    ChoosePic(Seg8bPid);
    Paste;
    DoOr;
    ShowMessage('calculating');

    SaveState;
    SetNewSize(32,32);
    MakeNewWindow('Sums');
    sumPid := pidNumber;
    
    Sum16uMark(proc16Pid,Seg8bPid,sumPid);
    {also need standard deviation, min, max}
    SetCounter(513);
    SetOptions('area,user1,user2,Min/Max,X-Y Center,Angle');
    ChoosePic(Seg8bPid);
    KillRoi;
    Measure; {get area from histogram array}
    SetCounter(513);
    i := 0;
    if histogram[255] = 0 then begin
        putMessage('no background');
        exit;
    end;
    avgBkg := GetPixVec32s(sumPid,255) / histogram[255];
    total := 0;
    for k := 1 to 255 do begin
        sum := GetPixVec32s(sumPid,k);
        area := histogram[k];
        if area <> 0 then begin
            i := i + 1;
            rMin[i] := k;
            rMax[i] := rMax[k+256];
            rArea[i] := area;
            rUser1[i] := sum;
            rAngle[i] := sum - area*AvgBkg;
            total := total + rAngle[i];
            rX[i] := rX[k+256];
            rY[i] := rY[k+256];
        end;
    end;
    i := i + 1;
    rArea[i] := 0;
    rUser1[i] := 0;
    rAngle[i] := 0;
    rUser2[i] := 0;
    rX[i] := svL;
    rY[i] := svT;
    rMin[i] := svW;
    rMax[i] := svH;
    SetCounter(i); {zeros measurements above i, using k+256 is in vain}
    if total = 0 then total := 1;
    for k := 1 to i do begin
        rUser2[k] := rAngle[k] / total;
    end;
    disposePic(sumPid);
    SetUser1Label('sum');
    SetUser2Label('s-a*b/t');
    ShowResults;
    RestoreState;
    SelectPic(Seg8bPid);
    ShowResults;
    UpdateResults;
    Copy;
end;